perm filename REVAL2.LBK[F75,JMC] blob
sn#191107 filedate 1975-12-10 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002
C00004 ENDMK
Cā;
(DEFPROP ALLFNS
(NIL ELEM REVAL PRUP X1 X2 X3 X4 X5)
VALUE)
(DEFPROP ELEM
(NIL ATOM EQ EQUAL CAR CDR CONS NULL LIST CADR CAAR CDAR CDDR)
VALUE)
(DEFPROP REVAL
(LAMBDA(E A)
((LAMBDA (V)
(COND ((ATOM E) ((LAMBDA (W) (REVAL (CAR W) (CADR W))) (CDR (ASSOC E A))))
((EQ (CAR E) (QUOTE QUOTE)) (CADR E))
((EQ (CAR E) (QUOTE IF)) (COND ((REVAL (CADR E) A) (REVAL (CADDR E) A)) (T (REVAL (CADDDR E) A))))
((MEMBER (CAR E) ELEM)
(EVAL (CONS (CAR E) (MAPCAR (FUNCTION (LAMBDA (W) (LIST (QUOTE QUOTE) (REVAL W A)))) (CDR E)))))
(T
((LAMBDA(W)
(REVAL (CADDR W) (APPEND (PRUP (CADR W) (MAPCAR (FUNCTION (LAMBDA (Z) (LIST Z A))) (CDR E))) A)))
(GET (CAR E) (QUOTE EXPR))))) (SETQ COUNT (ADD1 COUNT)))))
EXPR)
(DEFPROP PRUP
(LAMBDA (U V) (COND ((NULL U) NIL) (T (CONS (CONS (CAR U) (CAR V)) (PRUP (CDR U) (CDR V))))))
EXPR)